home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor2
/
das.src
< prev
next >
Wrap
Text File
|
1992-08-18
|
7KB
|
345 lines
%%HP: T(3)A(D)F(.);
@ DAS, by Robert Bellman, Jr.
DIR
STCOM
\<< DATE DUP 'D1'
STO TIME DUP HMS\->
'T1' STO .0002 HMS+
'SCAN1' 5 8192 * 4
\->LIST STOALARM DROP
\>>
STOP
\<< 1 DELALARM
\>>
SCAN1
\<< DROP RDCHK4
DATE TIME HMS\->
LAPS4 SWAP CONV4
\>>
RDCHK4
\<<
DO "1" XMIT
CLOSEIO OPENIO DROP
8 SRECV SWAP DUP
BYTES SWAP DROP
IF 13 \=/
THEN DROP
1.5 WAIT
ELSE SWAP
END
UNTIL 1 ==
END
\>>
CONV4
\<< 1 SWAP DUP
SIZE 2 / 1 SWAP
START DUP 3
PICK DUP SUB NUM
SWAP DUP 4 PICK 1 +
DUP SUB NUM 3 ROLL
256 * + .000152589
* 3 ROLL 2 + 3 ROLL
NEXT DROP2
\>>
LAPS4
\<< SWAP D1 SWAP
DDAYS DUP
IF 1 <
THEN DROP T1
-
ELSE 24 * T1
- +
END
\>>
STSIM
\<< DATE TIME
.0002 HMS+ 'SCAN' 5
8192 * 4 \->LIST
STOALARM DROP
\>>
SCAN
\<< DROP RDCHK4
\>>
DEL2
\<< OBJ\-> DROP
SWAP OBJ\-> DROP \-> l
r
\<< D1 OBJ\->
OBJ\-> DROP DUP ROT *
\-> s
\<< s 2 +
DO DUP
PICK SWAP 3 PICK -
SWAP
UNTIL r >
END s
SWAP 3 PICK + 1 +
\>>
DO 1 4 PICK
START DUP
ROLL DROP 1 - SWAP
1 - SWAP
NEXT
UNTIL DUP
PICK l >
END
\>> DROP 2 PICK
/ SWAP 2 \->LIST
\->ARRY
\>>
RANY
\<< OBJ\-> DROP \-> r
\<< D1 OBJ\->
OBJ\-> DROP DUP ROT *
2 +
WHILE 2 3
PICK + PICK r >
REPEAT 1 3
PICK
START 3
ROLL DROP 1 -
NEXT
END
\>> 2 - 2 PICK
/ SWAP 2 \->LIST
\->ARRY
\>>
LANY
\<< OBJ\-> DROP \-> l
\<< D1 OBJ\->
OBJ\-> DROP DUP ROT *
2 +
WHILE DUP
PICK l <
REPEAT 1 3
PICK
START DUP
ROLL DROP 1 -
NEXT
END
\>> 2 - 2 PICK
/ SWAP 2 \->LIST
\->ARRY
\>>
ORG
\<< OBJ\-> DROP
DEPTH 5 / 5 2 \->LIST
\->ARRY
\>>
SETCOLS
\<< SETXCOL
SETYCOL FROM42
\>>
OTTO
\<< MIN\GS 1 GET
DUP 'XMIN' STO MAX\GS
1 GET XRNG MIN\GS 2
GET DUP 'YMIN' STO
MAX\GS 2 GET YRNG
SPLOT L2PLT
\>>
SPLOT
\<< ERASE { # 0d
# 0d } PVIEW XMIN
YMIN R\->C "COL:" XX
\->STR + "COL:" Y
\->STR + 3 \->LIST AXES
LABEL DRAX -49 CF
-50 CF EPTS
\>>
L2PLT
\<< { # 0d # 0d }
PVIEW \GSDAT OBJ\->
OBJ\-> DROP * 1 + DR
SWAP DR ROT SWAP
R\->C SWAP 1 - DUP 2
/ 1 - 1 SWAP
START DR SWAP
DR ROT SWAP R\->C ROT
SWAP LINE LASTARG
SWAP DROP SWAP 2 -
NEXT DROP2
GRAPH
\>>
XLIM
\<<
"ENTER MINIMUM X:"
"" INPUT OBJ\-> DUP
'XMIN' STO
"ENTER MAXIMUM X:"
"" INPUT OBJ\-> XRNG
\>>
YLIM
\<<
"ENTER MINIMUM Y:"
"" INPUT OBJ\-> DUP
'YMIN' STO
"ENTER MAXIMUM Y:"
"" INPUT OBJ\-> YRNG
\>>
FROM42
\<< D1 TRN OBJ\->
DUP OBJ\-> DROP * DUP
3 ROLLD 2 + ROLLD
\->LIST DUP 3 PICK
OBJ\-> DROP SWAP DROP
DUP DUP XX * SWAP -
1 + SWAP XX * SUB
SWAP 3 PICK OBJ\->
DROP SWAP DROP DUP
DUP Y * SWAP - 1 +
SWAP Y * SUB + OBJ\->
1 + ROLL OBJ\-> SWAP
ROT DROP 2 \->LIST
\->ARRY TRN STO\GS
\>>
SETYCOL
\<<
"ENTER Y COLUMN:"
"" INPUT OBJ\-> 'Y'
STO
\>>
DR
\<< DUP ROLL
\>>
SETXCOL
\<<
"ENTER X COLUMN:"
"" INPUT OBJ\-> 'XX'
STO
\>>
ASTR
\<< OBJ\-> SWAP
\->STR ", " + SWAP +
\>>
EPTS
\<< DEC PPAR OBJ\->
6 DROPN ASTR 1
\->GROB SWAP ASTR 1
\->GROB { # 5d # 56d
} SWAP PICT 3 ROLLD
GOR PICT SWAP DUP
SIZE DROP 131 SWAP
- # 3d 2 \->LIST SWAP
GOR
\>>
LOTTO
\<< LSPLT LGPLT
\>>
LSPLT LEPTS
LGPLT
\<< { # 0d # 0d }
PVIEW \GSDAT OBJ\->
OBJ\-> DROP * 1 + DR
SWAP DR ROT LOG
SWAP R\->C SWAP 1 -
DUP 2 / 1 - 1 SWAP
START DR SWAP
DR ROT LOG SWAP R\->C
ROT SWAP LINE
LASTARG SWAP DROP
SWAP 2 -
NEXT DROP2
GRAPH
\>>
DRSEM
\<< DUP2 CHKPN
IF 1 \=/
THEN ABS SWAP
ABS +
ELSE - ABS
END DUP 130
SWAP / DUP \-> b
\<< 0 ROT 1
SWAP
START 1 1 9
START DUP
LOG 4 PICK * 3 PICK
+ LNE 1 +
NEXT DROP
b + DUP LLNE
NEXT
\>> DROP2 64 10
/ DUP \-> c
\<< 64 1 10
START DUP
HLNE c -
NEXT
\>> DROP2 {
# 0d # 63d } DUP {
# 0d # 0d } LINE {
# 130d # 63d } LINE
\>>
LNE
\<< \-> a
\<< a # 0d +
# 61d 2 \->LIST a
# 0d + # 62d 2
\->LIST LINE
\>>
\>>
LLNE
\<< \-> a
\<< a # 0d +
# 59d 2 \->LIST a
# 0d + # 63d 2
\->LIST LINE
\>>
\>>
HLNE
\<< \-> a
\<< a # 0d +
# 2d SWAP 2 \->LIST a
# 0d + # 0d SWAP 2
\->LIST LINE
\>>
\>>
YMIN 0
XMIN .0010155911
CHKPN
\<< SIGN SWAP
SIGN +
IF 0 \=/
THEN 1
ELSE -1
END
\>>
Y 2
XX 1
PPAR {
(.0010155911,0)
(.03439643,7.503869253)
X 0 {
(.0010155911,0)
"COL:1" "COL:2" }
SCATTER Y }
\GSDAT 0
T1 12.5151329208
D1
[[ .0010155911 7.503869253 5.003851077 5.003851077 4.964788293 ]
[ .0023804728 .997016526 .996711348 .996711348 .997321704 ]
[ .003769633 .996863937 .996711348 .996711348 .997321704 ]
[ .0051616075 .997321704 .997169115 .997169115 .997626882 ]
[ .0065531753 .998084649 .99793206 .997779471 .998237238 ]
[ .0079486422 0 0 0 0 ]
[ .009793735 1.999984023 2.000136612 2.000136612 2.000746968 ]
[ .0107279458 2.001204735 2.000289201 1.999678845 2.000746968 ]
[ .0121211411 1.992964929 1.992659751 1.99281234 1.993270107 ]
[ .0135182019 1.999831434 2.000136612 1.999373667 2.000746968 ]
[ .0149083455 2.001204735 2.001052146 2.000746968 2.001815091 ]
[ .0162999811 3.004324821 3.003714465 3.003561876 3.005240355 ]
[ .0176919894 2.992117701 2.991659934 2.991354756 2.992728057 ]
[ .0197528414 3.003867054 3.003256698 3.002798931 3.004172232 ]
[ .020568305 3.003104109 3.002341164 3.001883397 3.003714465 ]
[ .0218668958 4.004240538 4.003325004 4.002867237 4.004698305 ]
[ .0232599555 4.004545716 4.004087949 4.003630182 4.005613839 ]
[ .0246550497 6.010175532 6.009870354 6.009412587 6.012311778 ]
[ .0260440064 6.010328121 6.008802231 6.008649642 6.011396244 ]
[ .0274358114 6.009717765 6.008802231 6.008497053 6.011396244 ]
[ .0288277519 3.003561876 3.003104109 3.002798931 3.004172232 ]
[ .0302229816 3.005392944 3.00447741 3.004324821 3.005850711 ]
[ .0316119722 1.999984023 1.999678845 1.999526256 2.000289201 ]
[ .0330037094 2.002120269 2.001052146 2.000746968 2.001815091 ]
[ .03439643 1.999373667 1.999068489 1.998763311 1.999678845 ]]
END